home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / A-COMAL Series / (k)aab.d64 / proc.oki'dump < prev    next >
Text File  |  2007-02-28  |  3KB  |  88 lines
  1. 0010 //  ╧╦╔─┴╘┴ ├╧╠╧╥ ─╒═╨
  2. 0020 //
  3. 0030 //  BY ╘ERRY ╥ICKETTS
  4. 0040 //     215 ═OUNTAIN ╫AY
  5. 0050 //     ╙ANTA ├RUZ, ├ALIF. 95060
  6. 0060 //     408-423-7485
  7. 0070 //
  8. 0080 //  BASED ON '╟EMINI 10╪ ├OLOR ╙CREENDUMP'
  9. 0090 //     BY ╥AY ├ARTER
  10. 0100 //     SEE ├╧═┴╠ ╘╧─┴┘ #9
  11. 0110 //
  12. 0120 //   ╘HIS PROCEDURE WILL PRINT THE MULTICOLOR GRAPHICS SCREEN
  13. 0130 // ON A ╧KIDATA 92 (OR SIMILAR) PRINTER USING GREY SHADING FOR THE
  14. 0140 // COLORS. ┼ACH BIT PAIR REPRESENTING ONE COLOR DOT IS PRINTED AS
  15. 0150 // A 2 DOT VERT BY 4 DOT HORIZ PATTERN.
  16. 0160 //    ╘HE PROGRAM IS WRITTEN ENTIRELY IN ├OMAL AND IS THUS VERY SLOW.
  17. 0170 // ╔ AM IN THE PROCESS OF WRITING A MACHINE LANGUAGE VERSION WHICH
  18. 0180 // SHOULD BE MUCH FASTER.
  19. 0190 //
  20. 0200 //
  21. 0210 ╨╥╧├ DUMPSCREEN ├╠╧╙┼─
  22. 0220   ╒╙┼ SYSTEM
  23. 0230   ─╔═ A$ ╧╞ 404
  24. 0240   ╧╨┼╬ ╞╔╠┼ 4,"LP:/S8/L+",╫╥╔╘┼ //   OPEN FILE FOR PRINTER
  25. 0250   ╨╥╔╬╘ ╞╔╠┼ 4: ""24"" //            RESET THE PRINTER
  26. 0260   ╨╥╔╬╘ ╞╔╠┼ 4: ""27"%├075" //       MOVE LEFT MARGIN
  27. 0270   ╨╥╔╬╘ ╞╔╠┼ 4: ""27"%9"8"" //       SET TO 8/144 INCH PER LINE"
  28. 0280   ╨╥╔╬╘ ╞╔╠┼ 4: ""3"" //             SELECT GRAPHICS MODE
  29. 0290   ╨╥╔╬╘ ╞╔╠┼ 4: ""3""10"" //         CLEAR THE BUFFER
  30. 0300   ─╔═ CPAT(0:15,2) //                READ COLOR PATTERNS
  31. 0310   ╞╧╥ I:=0 ╘╧ 15 ─╧
  32. 0320     ╞╧╥ J:=1 ╘╧ 2 ─╧
  33. 0330       ╥┼┴─ CPAT(I,J)
  34. 0340     ┼╬─╞╧╥ J
  35. 0350   ┼╬─╞╧╥ I
  36. 0360   ╞╧╥ COL#:=0 ╘╧ 39 ─╧ //            DO 40 COLS
  37. 0370     ╞╧╥ PAIR#:=0 ╘╧ 3 ─╧ //          1 OUTPUT ROW PER PAIR OF BYTES
  38. 0380       A$:=""
  39. 0390       ╞╧╥ ROW#:=24 ╘╧ 0 ╙╘┼╨ -1 ─╧ // DO 25 ROWS PER COL
  40. 0400         ADD:=$E000+320*ROW#+8*COL# // SCREEN ADDRESS
  41. 0410         LOC:=$D800+40*ROW#+COL# //    COLOR RAM ADDRESS
  42. 0420         SETPAGE(6) //                 SELECT COLOR RAM
  43. 0430         COLORAM:=╨┼┼╦(LOC) ═╧─ 16 //  GET COLOR SCREEN INFO
  44. 0440         BACKX:=╨┼┼╦(53281) ═╧─ 16
  45. 0450         SETPAGE(0) //                 SELECT RAM UNDER ROM
  46. 0460         SCRMEM:=╨┼┼╦(LOC)
  47. 0470         SCRMEMHI:=SCRMEM ─╔╓ 16
  48. 0480         SCRMEMLO:=SCRMEM ═╧─ 16
  49. 0490         ╞╧╥ BYTE#:=7 ╘╧ 0 ╙╘┼╨ -1 ─╧ //READ 8 BYTES PER CHAR
  50. 0500           VALX:=╨┼┼╦(ADD+BYTE#) //     READ THE SCREEN
  51. 0510           ├┴╙┼ PAIR# ╧╞ //             GET THE BIT PAIR FOR EACH COLOR
  52. 0520           ╫╚┼╬ 0
  53. 0530             VALX:=VALX ─╔╓ 64
  54. 0540           ╫╚┼╬ 1
  55. 0550             VALX:=(VALX ─╔╓ 16) ═╧─ 4
  56. 0560           ╫╚┼╬ 2
  57. 0570             VALX:=(VALX ═╧─ 16) ─╔╓ 4
  58. 0580           ╫╚┼╬ 3
  59. 0590             VALX:=VALX ═╧─ 4
  60. 0600           ┼╬─├┴╙┼ 
  61. 0610           ├┴╙┼ VALX ╧╞ //              FIGURE OUT COLOR OF PAIR
  62. 0620           ╫╚┼╬ 0
  63. 0630             VALX:=BACKX
  64. 0640           ╫╚┼╬ 1
  65. 0650             VALX:=SCRMEMHI
  66. 0660           ╫╚┼╬ 2
  67. 0670             VALX:=SCRMEMLO
  68. 0680           ╫╚┼╬ 3
  69. 0690             VALX:=COLORAM
  70. 0700           ╧╘╚┼╥╫╔╙┼ 
  71. 0710             ├╠╧╙┼
  72. 0720             ╙╘╧╨ "ERR IN CASE"
  73. 0730           ┼╬─├┴╙┼ 
  74. 0740           A$:=A$+├╚╥$(CPAT(VALX,2))+├╚╥$(CPAT(VALX,1))
  75. 0750         ┼╬─╞╧╥ BYTE#
  76. 0760       ┼╬─╞╧╥ ROW#
  77. 0770       A$:=A$+""3""+""10"" //          ADD LF TO LINE
  78. 0780       ╨╥╔╬╘ ╞╔╠┼ 4: A$ //             SEND 1 LINE TO PRINTER
  79. 0790     ┼╬─╞╧╥ PAIR#
  80. 0800   ┼╬─╞╧╥ COL#
  81. 0810   ╨╥╔╬╘ ╞╔╠┼ 4: ""3""2""
  82. 0820   ├╠╧╙┼
  83. 0830   ─┴╘┴ $0F,$0F,0,0,$0F,0,5,$0A //      COLOR CODES FOR PAIRS OF BITS
  84. 0840   ─┴╘┴ $0A,$0A,6,9,$0D,$0B,8,2
  85. 0850   ─┴╘┴ $0A,1,7,$0E,5,0,$0D,$0E
  86. 0860   ─┴╘┴ 6,7,4,2,1,8,0,9
  87. 0870 ┼╬─╨╥╧├ DUMPSCREEN
  88.